home *** CD-ROM | disk | FTP | other *** search
/ BCI NET / BCI NET Dec 94.iso / archives / telecomm / bbs / maxsdoors2.lha / Amigastats.lha / AmigaStats.bas < prev    next >
BASIC Source File  |  1992-11-11  |  7KB  |  252 lines
  1. 'no window
  2. REM $OPTION Y
  3.  
  4. 'Open the libraries we will need
  5.  
  6. LIBRARY "exec.library"
  7. LIBRARY "dos.library"
  8. LIBRARY "intuition.library"
  9.  
  10. 'and declare the functions we'll need
  11.  
  12. DECLARE FUNCTION AllocMem& LIBRARY
  13. DECLARE FUNCTION FreeMem& LIBRARY
  14. DECLARE FUNCTION FindTask& LIBRARY
  15. DECLARE FUNCTION AllocSignal& LIBRARY
  16. DECLARE FUNCTION AddPort& LIBRARY
  17. DECLARE FUNCTION Forbid& LIBRARY
  18. DECLARE FUNCTION Permit& LIBRARY
  19. DECLARE FUNCTION FindPort& LIBRARY
  20. DECLARE FUNCTION PutMsg& LIBRARY
  21. DECLARE FUNCTION WaitPort& LIBRARY
  22. DECLARE FUNCTION GetMsg& LIBRARY
  23. DECLARE FUNCTION RemPort& LIBRARY
  24. DECLARE FUNCTION FreeSignal& LIBRARY
  25.  
  26.  
  27. ON ERROR GOTO error.handler
  28.  
  29. 'And set up the variables we'll need as global
  30.  
  31. DIM SHARED PortAddress&, TaskAddr&, Dummy%, MsgPortName$, MsgPortName2$
  32. DIM SHARED Sig%, ControlPort&, ErrCode%, Arg1&, Arg2&, Reply&
  33. DIM SHARED i&, j%, Flag%, esc$, a%, L&, NameMemAddr&
  34.  
  35. '=================================================================
  36.  
  37. IF COMMAND$="" THEN 
  38.   WINDOW 1,"AmigaStats",(0,0)-(300,100),22
  39.   PRINT "Major problems: couldn't get the node number from the BBS!!"  
  40.   ErrCode%=1
  41.   GOTO Exitt
  42. END IF
  43.  
  44. 'OK, so now we define the portnames, with terminating zeros
  45.  
  46. trick:
  47. MsgPortName$="DoorControl"+COMMAND$+CHR$(0)
  48. MsgPortName2$="DoorReply"+COMMAND$+CHR$(0)
  49.  
  50.  
  51. CALL GetPort
  52.  
  53. IF ControlPort&=0 THEN
  54.   WINDOW 1,"AmigaStats",(0,0)-(300,100),22
  55.   PRINT "Can't find the BBS's control port!  Exiting ...."
  56.   ErrCode%=4
  57. END IF
  58.  
  59. IF ErrCode% <> 0 THEN GOTO Exitt
  60.  
  61. '######################################################################
  62. 'Your Programme goes in here!!!!!
  63. '######################################################################
  64. cr$ = CHR$(13)
  65. ff$ = CHR$(12)
  66.  
  67. Call Printstring(ff$+cr$)
  68.  
  69. If Command$ = "0" Then exitt  'Quit if logged in locally....
  70.  
  71.  
  72. Call Hotkey(cr$+"   Would you like to see some stats on Murray's Computer? <Y/n> ",X%)
  73.  
  74. X$ = UCASE$(CHR$(X%))
  75. IF X$ = "N" Then
  76.    Call Printstring("No!")
  77.    Goto Exitt
  78. Else
  79.    Call Printstring("Yes!")
  80.  
  81.    Call DoMenu(27,0,"Execute S:Stats")
  82.    Call Printfile("BBS:Text/AmigaStats.text")
  83.    Call Printstring(FF$)
  84. End If
  85.  
  86. '######################################################################
  87. 'And ENDS Here!
  88. '######################################################################
  89. Exitt:
  90.  
  91. CALL FreePort
  92.  
  93. LIBRARY CLOSE
  94.  
  95. SYSTEM
  96.  
  97. Error.Handler:
  98. St$=CHR$(13)+CHR$(27)+"[31mThere has been a problem with the proggy!!!"+CHR$(13)
  99. CALL PrintString(St$)
  100. St$="Please notify %a!!"+CHR$(13)+CHR$(13)
  101. CALL PrintString(St$)
  102. St$=CHR$(27)+"[32mPress any key to continue..."
  103. CALL Hotkey("",X%)
  104. 'don't attempt to free the memory - we don't know where the error was!
  105. GOTO exitt
  106.  
  107. SUB getport STATIC
  108.   'sub to determine if MAX'sBBS message port exists &, if it does, to open
  109.   'a reply port for it
  110.   'First, allocate the memory we need for msgport etc
  111.   PortAddress&=AllocMem&(140&,&H10001)
  112.   IF PortAddress&=0 THEN
  113.     WINDOW 1,"AmigaStats Error Window",(0,0)-(300,100),22
  114.     PRINT "Couldn't allocate the memory!"
  115.     ErrCode%=2
  116.     GOTO Out
  117.   END IF  
  118.   'Now, find our task structure
  119.   TaskAddr&=FindTask&(0)
  120.   'and put it in the messageport structure
  121.   POKEL PortAddress&+16,TaskAddr&
  122.   'now, allocate a signal bit
  123.   Sig% = AllocSignal&(-1)
  124.   IF Sig%<0 THEN
  125.     ErrCode%=3
  126.     GOTO Out
  127.   END IF
  128.   'and do some setups
  129.   POKE PortAddress&+8,4
  130.   POKEL PortAddress&+10,SADD(MsgPortName2$)
  131.   POKE PortAddress&+15,Sig%
  132.   POKE PortAddress&+42,5
  133.   POKEW PortAddress&+52,106
  134.   POKEL PortAddress&+48,PortAddress&
  135.   'and add our msgport to the system
  136.   Reply&=AddPort&(PortAddress&)
  137.   'now, let's find MAX'sBBS port
  138.   Dummy%=Forbid&
  139.   ControlPort&=FindPort&(SADD(MsgPortName$))
  140.   Dummy%=Permit&
  141.   'ok, that's enough for now.  Lets go back
  142.   Out:
  143. END SUB
  144.  
  145. SUB FreePort STATIC
  146.   'Was there an error & if so, what do we do?
  147.   IF ErrCode% = 1 THEN GOTO Sig1
  148.   IF ErrCode% = 2 THEN GOTO Sig2
  149.   IF ErrCode% = 3 THEN GOTO Sig3
  150.   IF ErrCode% = 4 THEN GOTO Sig4
  151.   'OK.  Either we're finished or the carrier has been lost (& we're
  152.   'still finished)
  153.   CALL GetMsgPrt (Arg1&,Arg2&)
  154.   POKEW Arg2&,20                    'This is the command we're passing
  155.   'now we put the message into the message queue
  156.   Reply&=PutMsg&(ControlPort&,Arg1&)
  157.   'and wait for a reply
  158.   Pause:
  159.   Reply&=WaitPort&(PortAddress&)
  160.   Reply&=GetMsg&(PortAddress&)
  161.   IF Reply&=0 THEN GOTO Pause
  162.   Sig4:         'General cleanup routine
  163.   Dummy%=RemPort&(PortAddress&)     'free the messageport
  164.   Dummy%=PEEK(PortAddress&+15)      'get the signal number
  165.   Dummy%=FreeSignal&(Dummy%)        'and frre the signal
  166.   Sig3:
  167.   Dummy%=FreeMem(PortAddress&,140&)
  168.   Sig2:
  169.   Sig1:
  170. END SUB
  171.  
  172. SUB GetMsgPrt(Arg1&, Arg2&) STATIC
  173.   'this little routine sets up the pointers for messaging
  174.   'Arg1& corresponds to register A1, which is the passed to the PutMsg&
  175.   'function.
  176.   Arg1&=PortAddress&+34
  177.   Arg2&=PortAddress&+54
  178.   POKEL Arg2&+2,0
  179. END SUB
  180.  
  181. SUB PrintString(St$) STATIC
  182.   'routine to print a text string
  183.   CALL GetMsgPrt (Arg1&, Arg2&)
  184.   POKEW Arg2&,1       'command number
  185.   POKEW Arg2&+2,0     'terminating null
  186.   FOR i&=1 TO LEN(St$)
  187.     POKE Arg2&+3+i&,ASC(MID$(St$,i&,1))   'put the string in
  188.   NEXT
  189.   POKE Arg2&+3+i&,0
  190.   CALL PutWaitMsg
  191. END SUB
  192.  
  193. SUB PutWaitMsg STATIC
  194.   'routine to put the message to the port & await a reply
  195.   LOCAL Temp&, Locn&, Tempp&
  196.   Reply&=PutMsg&(ControlPort&,Arg1&)
  197.   'and wait for a reply
  198.   Pause1:
  199.   Reply&=WaitPort&(PortAddress&)
  200.   Reply&=GetMsg&(PortAddress&)
  201.   IF Reply&=0 THEN GOTO Pause1
  202.   Tempp&=PEEKW(Reply&+24&+80&)
  203.   IF Tempp&<>0 THEN GOTO Exitt                'lost carrier
  204. END SUB
  205.  
  206. SUB PrintFile(F$) STATIC
  207.   'routine to print a text file
  208.   CALL GetMsgPrt (Arg1&, Arg2&)
  209.   POKEW Arg2&,10      'command number
  210.   POKEW Arg2&+2,0     'terminating null
  211.   FOR i&=1 TO LEN(F$)
  212.     POKE Arg2&+3+i&,ASC(MID$(F$,i&,1))   'put the string in
  213.   NEXT
  214.   POKE Arg2&+3+i&,0
  215.   CALL PutWaitMsg
  216. END SUB
  217.  
  218. SUB hotkey (F$,K%) STATIC
  219.   'routine to print a string & get any keypress
  220.   CALL GetMsgPrt (Arg1&, Arg2&)
  221.   POKEW Arg2&,8       'command number
  222.   POKEW Arg2&+2,0     'terminating null
  223.   FOR i&=1 TO LEN(F$)
  224.     POKE Arg2&+3+i&,ASC(MID$(F$,i&,1))   'put the string in
  225.   NEXT
  226.   POKE Arg2&+3+i&,0
  227.   CALL PutWaitMsg
  228.   K%=PEEK(Arg2&+4)
  229. END SUB
  230.  
  231. SUB UserInfo2(St$,Which%) STATIC
  232.   'Routine to get (numerical) user / system details
  233.   CALL GetMsgPrt (Arg1&, Arg2&)
  234.   POKEW Arg2&,13           'command number
  235.   POKEW Arg2&+2,Which%     
  236.   CALL PutWaitMsg
  237.   st$=STR$(PEEKW(Arg2&+2))
  238. END SUB
  239.  
  240. SUB DoMenu(A,B,F$) STATIC
  241.   'call a maxsBBS menu function
  242.   CALL GetMsgPrt (Arg1&, Arg2&)
  243.   POKEW Arg2&,A+100  ' command number
  244.   POKEW Arg2&+2,B    ' subcommand
  245.   FOR i&=1 TO LEN(F$)
  246.     POKE Arg2&+3+i&,ASC(MID$(F$,i&,1))   'put the string in
  247.   NEXT
  248.   POKE Arg2&+3+i&,0
  249.   CALL PutWaitMsg
  250. END SUB
  251.  
  252.